ReservoirReadStatus Subroutine

private subroutine ReservoirReadStatus(filename)

Read reservoir stage and diversion discharge from file

Arguments

Type IntentOptional Attributes Name
character(len=*), intent(in) :: filename

Variables

Type Visibility Attributes Name Initial
type(Reservoir), public, POINTER :: currentReservoir
integer(kind=short), public :: i
character(len=300), public :: string
type(TableCollection), public :: tabs

Source Code

SUBROUTINE ReservoirReadStatus &
  !
  (filename)

IMPLICIT NONE


!arguments with intent(in):
CHARACTER ( LEN = *), INTENT (IN) :: filename

! local declarations:
INTEGER (KIND = short) :: i
CHARACTER (LEN = 300)  :: string
TYPE (TableCollection) :: tabs
TYPE (Reservoir), POINTER :: currentReservoir !points to current reservoir

!------------------------------end of declarations-----------------------------

!read tables
CALL TableNew ( filename, tabs )

!set reservoir stage
currentReservoir => pools
DO i = 1, nReservoirs
    string = TRIM ( ToString ( currentReservoir % id ) )
    
    CALL TableGetValue (  valueIn = string, &
                          tables = tabs, &
                          id = 'reservoir stage', &
                          keyIn = 'id', &
                          keyOut = 'stage', &
                          valueOut = currentReservoir % stage )

    currentReservoir => currentReservoir % next
END DO 

!set diversion discharge
IF ( nReservoirsWithDiversion > 0 ) THEN
    currentReservoir => pools
    DO i = 1, nReservoirs
        IF ( currentReservoir % bypassIsPresent ) THEN
            string = TRIM ( ToString ( currentReservoir % id ) )
    
            CALL TableGetValue (  valueIn = string, &
                        tables = tabs, &
                        id = 'diverted discharge', &
                        keyIn = 'id', &
                        keyOut = 'Qin', &
                        valueOut = currentReservoir % bypass % QinChannel )
            
             CALL TableGetValue (  valueIn = string, &
                        tables = tabs, &
                        id = 'diverted discharge', &
                        keyIn = 'id', &
                        keyOut = 'Qout', &
                        valueOut = currentReservoir % bypass % QoutChannel )
        END IF
        currentReservoir => currentReservoir % next
    END DO 
END IF

RETURN
END SUBROUTINE ReservoirReadStatus